home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
007
/
qbtools1.arc
/
AEPULMEN.BAS
< prev
next >
Wrap
BASIC Source File
|
1987-12-10
|
7KB
|
300 lines
rem $linesize:132
rem $title:'Application Engineer Standard Routines'
rem $subtitle:'Pull down menus - one ALWAYS highlit'
' Include the COMMON values
rem $include:'AESHARED.BAS'
sub Pull.Down.Menu static
'
' Pull.Down.Menu
'
' Will display a menu bar and list of horizontal options. The first
' horizontal option is highlit, with a list of options in a vertical
' format highlit under this bar. By using the up & down arrow keys, the
' options are selected (inverse video). By pressing the ENTER key, the
' selected option is returned in menop% . Using the left & right arrow
' keys moves the menu selection block left & right. Multiple selections
' are therefore possible in a menu, i.e menu & submenu. The values returned
' are menu% (horizontal selection) and menop% (the selection made within
' this sub-menu).
'
' Help numbers are available in a passed array (ae.hlp%). These are used
' in linking the options with help 'frames'.
'
dim m.disp$(12%)
locate ,,0
ae.sstack%=ae.sstack%+2000%
if ae.sstack%>10000% then
call ae.error("PDM AESTACK Overflow")
end if
frame.text$=" " ' Initial three spaces
for j%=1% to mcount%
frame.text$=frame.text$+ae.menu$(j%)+" "
next j%
max.l%=0%
res.yes%=0%
chop%=1%
high%=(ae.fg%(1%) and 7%)*16% + ae.hg%(1%)
norm%=(ae.bg%(1%) and 7%)*16% + ae.fg%(1%)
mch%=1%
m.prev%=1%
init%=1%
cycle%=0%
mbase%=mcount%
chk%=0%
alt%=0%
cur.up%=0%
cur.down%=0%
stor%=0%
menu%=0%
menop%=0%
for j%=1% to mcount%
if ae.op%(j%)>max.l% then
max.l%=ae.op%(j%)
end if
next j%
call getscreen(ae.screens%(ae.sstack%-1999%),2%,1%,4%,80%,0%,0%) ' get where title bars
max.l%=max.l%+5%
frame.text$=frame.text$+string$(75%-len(frame.text$),32%)
frame.text$=chr$(179%)+frame.text$+chr$(179%)
frame.top$=chr$(218%)+string$(len(frame.text$)-2%,196%)+chr$(191%)
frame.bot$=chr$(192%)+string$(len(frame.text$)-2%,196%)+chr$(217%)
call xqprint (frame.top$,2,1,norm%,0%)
call xqprint (frame.text$,3,1,norm%,0%)
call xqprint (frame.bot$,4,1,norm%,0%)
for j%=1% to mch%-1%
mbase%=mbase%+ae.op%(j%)
next j%
while cycle%=0%
if init%=0% then
call Get.Single(chk%,alt%)
end if
if alt%=2% then
if chk%=75% then ' Cursor left
mch%=mch%-1%
chop%=1%
end if
if chk%=77% then ' Cursor Right
mch%=mch%+1%
chop%=1%
end if
if chk%=80% then ' Cursor Down
chop%=chop%+1%
cur.down%=1%
end if
if chk%=72% then ' Cursor Up
chop%=chop%-1%
cur.up%=1%
end if
end if
if mch%<1% then
mch%=mcount%
end if
if mch%>mcount% then
mch%=1%
end if
if chop%>ae.op%(mch%) then
chop%=1%
end if
if chop%<1% then
chop%=ae.op%(mch%)
end if
if alt%=1% then ' Return Pressed
if chk%=13% then
cycle%=1%
end if
if chk%=27% then ' Escape key
cycle%=2%
chk%=13%
end if
if chk%<>13% then
char$=chr$(chk%)
call upcase(char$)
stor%=chop%
for k%=1% to ae.op%(mch%)
stor%=stor%+1%
if stor%>ae.op%(mch%) then
stor%=1%
end if
if mid$(ch.skip$,stor%,1%)=char$ then
chop%=stor%
k%=ae.op%(mch%)+1%
cur.up%=1%
end if
next k%
end if
end if
if (abs(m.prev%-mch%)+cur.up%+cur.down%+init%)<>0% then
if (cur.up%+cur.down%)=0% then
if res.yes%=1% then
call putscreen(ae.screens%(ae.sstack%-999%),sr.1%,sr.2%,sr.3%,sr.4%,sr.5%,0)
res.yes%=0%
end if
end if
mbase%=mcount%
for j%=1% to mch%-1%
mbase%=mbase%+ae.op%(j%)
next j%
while ae.menu$(mbase%+chop%)=""
if cur.down% then
chop%=chop%+1%
end if
if cur.up% then
chop%=chop%-1%
end if
if chop%>ae.op%(mch%) then
chop%=1%
end if
if chop%<1% then
chop%=ae.op%(mch%)
end if
wend
m.prev%=mch%
mlen%=len(ae.menu$(mch%))
mlen.top%=mlen%
for j%=1% to ae.op%(mch%)
if len(ae.menu$(mbase%+j%))>mlen% then
mlen%=len(ae.menu$(mbase%+j%))
end if
next j%
mlen%=mlen%+3%
mlen.top%=mlen.top%+3%
ch.skip$=string$(ae.op%(mch%),32%)
for j%=1% to ae.op%(mch%)
if j%=chop% then
fill.1$=chr$(175%)
fill.2$=chr$(174%)
else
fill.1$=" "
fill.2$=" "
end if
if len(ae.menu$(mbase%+j%))=0% then
m.disp$(j%)=chr$(195%)+string$(mlen%-1%,196%)+chr$(180%)
else
chkin$=mid$(ae.menu$(mbase%+j%),1%,1%)
call upcase(chkin$)
mid$(ch.skip$,j%,1%)=chkin$
m.disp$(j%)=chr$(179%)+fill.1$+ae.menu$(mbase%+j%)
m.disp$(j%)=m.disp$(j%)+string$((mlen%-1%)-len(m.disp$(j%)),32%)+fill.2$+chr$(179%)
end if
next j%
if (cur.down%+cur.up%)=0% then
m.bottom$=chr$(192%)+string$(mlen%-1%,chr$(196%))+chr$(217%)
m.top$=chr$(197%)+string$(mlen%-1%,chr$(196%))+chr$(194%)
if mlen%=mlen.top% then
mid$(m.top$,len(m.top$),1)=chr$(197%)
else
mid$(m.top$,len(ae.menu$(mch%))+4%,1%)=chr$(193%)
end if
q%=instr(frame.text$,ae.menu$(mch%))-2%
call xqprint (frame.top$,2,1,norm%,0%)
call xqprint (frame.text$,3,1,norm%,0%)
call xqprint (frame.bot$,4,1,norm%,0%)
call xqprint (chr$(194),2%,q%,norm%,0%)
call xqprint (chr$(179),3%,q%,norm%,0%)
call xqprint (chr$(194),2%,q%+3%+len(ae.menu$(mch%)),norm%,0%)
call xqprint (chr$(179),3%,q%+3%+len(ae.menu$(mch%)),norm%,0%)
call xqprint (m.top$,4%,q%,norm%,0%)
end if
if res.yes%=0% then
call getscreen(ae.screens%(ae.sstack%-999%),5%,q%,5%+ae.op%(mch%),q%+mlen%+3%,0%,0%)
sr.1%=5%
sr.2%=q%
sr.3%=5%+ae.op%(mch%)
sr.4%=q%+mlen%+3%
sr.5%=0%
sr.6%=1%
res.yes%=1%
end if
for j%=1% to ae.op%(mch%)
if j%<>chop% then
call xqprintd(m.disp$(j%),j%+4%,q%,norm%,0%)
end if
if j%=chop% then
sbeg$=mid$(m.disp$(j%),1%,1%)
smid$=mid$(m.disp$(j%),2%,len(m.disp$(j%))-1%)
send$=mid$(m.disp$(j%),len(m.disp$(j%)),1%)
call xqprintd(sbeg$,j%+4%,q%,norm%,0%)
call xqprintd(smid$,j%+4%,q%+1%,high%,0%)
call xqprintd(send$,j%+4%,q%+len(smid$),norm%,0%)
end if
next j%
if (cur.down%+cur.up%)=0% then
call xqprint(m.bottom$,4%+ae.op%(mch%)+1%,q%,norm%,0%)
end if
end if
cur.up%=0%
cur.down%=0%
init%=0%
wend
if res.yes%=1% then
call putscreen(ae.screens%(ae.sstack%-999%),sr.1%,sr.2%,sr.3%,sr.4%,sr.5%,0)
end if
call putscreen(ae.screens%(ae.sstack%-1999%),2%,1%,4%,80%,0%,0%)
ae.sstack%=ae.sstack%-2000%
if cycle%=1% then
menu%=mch% ' Menu Chosen
menop%=chop% ' Option within that menu
end if
if cycle%=2% then ' ESCAPE option
menu%=0%
menop%=0%
end if
end sub